home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / init.c < prev    next >
C/C++ Source or Header  |  1996-01-30  |  12KB  |  434 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. #ifdef MONITOR
  10. char MON_PACKAGE_NAME[33] = "";
  11. #endif
  12.  
  13. #define GEN
  14.  
  15. #include "hdr.h"
  16. #include "vars.h"
  17. #include "gvars.h"
  18. #include "libhdr.h"
  19. #include "segment.h"
  20. #include "slot.h"
  21. #include "ifile.h"
  22. #include "readp.h"
  23. #include "setp.h"
  24. #include "genp.h"
  25. #include "miscp.h"
  26. #include "smiscp.h"
  27. #include "arithp.h"
  28. #include "axqrp.h"
  29. #include "initp.h"
  30.  
  31. static Tuple precedes_map_new();
  32. static void init_predef_exceptions();
  33. static void init_predef_exception(int, int, int, char *);
  34.  
  35. /* These are defined here since type Segment not known in gvars.[ch] */
  36. Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  37. Segment FIELD_TABLE, VARIANT_TABLE;
  38. Tuple units_in_compilation;
  39.  
  40. /* INITALIZATIONS AND FINALIZATION
  41.  * General initialization
  42.  */
  43.  
  44. void initialize_1()                                            /*;initialize_1*/
  45. {
  46.     /*
  47.      * Initializes global variables that are to be kept between the two
  48.      * phases of generation.
  49.      */
  50.  
  51.     int    i;
  52.  
  53.     /* initialize FIELD_TABLE and VARIANT_TABLE. These are data segments
  54.      * that are reset to be empty but are not reallocated for each unit
  55.      */
  56.     FIELD_TABLE = segment_new(SEGMENT_KIND_DATA, 0);
  57.     VARIANT_TABLE = segment_new(SEGMENT_KIND_DATA, 0);
  58.     /* tree maps */
  59.     ivalue_1 = int_fri(1); 
  60.     ivalue_10 = int_fri(10);
  61.     int_const_0 = int_const(0);
  62.     rat_value_10 = rat_fri(ivalue_1, ivalue_10);
  63.  
  64.     int_const_null_task = int_const(-1);
  65.  
  66.     /*initializations of variables used only by generator */
  67.     /* explicit_ref_0 is used to pass addresses to be filled in later, and
  68.      * corresponds to [0, 0] case in SETL version.
  69.      */
  70.     explicit_ref_0 = explicit_ref_new(0, 0);
  71.     global_reference_tuple = tup_new(0);
  72.  
  73.     N_SIDE(OPT_NODE) = FALSE;
  74.  
  75.     /* AXQ maps: */
  76.     CODE_SEGMENT_MAP = tup_new(0);
  77.     DATA_SEGMENT_MAP = tup_new(0);
  78.     /* Global variables */
  79.     EMAP = tup_new(0);
  80. #ifdef TBSN
  81.     PREDEF_UNITS       = [[], {}];
  82.     /* These are handled using EMAP in C version */
  83.     STATIC_DEPTH       = {
  84.     };
  85.     POSITION       = {
  86.     };
  87.     PATCHES       = {
  88.     };
  89.     EQUAL       = {
  90.     };
  91. #endif
  92.     CODE_PATCH_SET  = tup_new(0);
  93.     DATA_PATCH_SET  = tup_new(0);
  94.     PARAMETER_SET   = tup_new(0);
  95.     RELAY_SET       = tup_new(0);
  96. #ifdef TBSN
  97.     axqfiles_read   = {
  98.         '_MEMORY'    };
  99.     instruction_stack    = [];
  100.     deleted_instructions = 0;
  101.     BTIME        = 0;
  102.     optimizable_codes    = domain automat0 +/{
  103.         {x, y    }
  104. :
  105.     [x, y] in domain(automat1)+domain(automat2)};
  106. #endif
  107.     /*    Slots initialization */
  108.     /* INIT_SLOTS and MAX_INDEX are procedures in C version, defined at
  109.      * the end of this file
  110.      */
  111.     DATA_SLOTS = tup_new(0);
  112.     CODE_SLOTS = tup_new(0);
  113.     /*
  114.      * EXCEPTION_SLOTS = { ['CONSTRAINT_ERROR', 1],
  115.      *            ['NUMERIC_ERROR',    2],
  116.      *            ['PROGRAM_ERROR',    3],
  117.      *            ['STORAGE_ERROR',    4],
  118.      *            ['TASKING_ERROR',    5]
  119.      *            ['SYSTEM_ERROR',    6]
  120.      *            };
  121.      */
  122.     EXCEPTION_SLOTS = tup_new(5);
  123.     EXCEPTION_SLOTS[1] = (char *) slot_new(symbol_constraint_error, 1);
  124.     EXCEPTION_SLOTS[2] = (char *) slot_new(symbol_numeric_error, 2);
  125.     EXCEPTION_SLOTS[3] = (char *) slot_new(symbol_program_error, 3);
  126.     EXCEPTION_SLOTS[4] = (char *) slot_new(symbol_storage_error, 4);
  127.     EXCEPTION_SLOTS[5] = (char *) slot_new(symbol_tasking_error, 5);
  128.     if (!compiling_predef)  {
  129.         /* if not compiling predef, make room for predef slots */
  130.         EXCEPTION_SLOTS = tup_exp(EXCEPTION_SLOTS, 15);
  131.         init_predef_exceptions();
  132.     }
  133.  
  134.     PRECEDES_MAP = precedes_map_new();
  135.  
  136.     compilation_table = tup_new(num_predef_units);
  137.     for (i = 1; i <= num_predef_units; i++) compilation_table[i] = (char *) i;
  138.     late_instances    = tup_new(8);
  139.     late_instances[1] = strjoin("spSEQUENTIAL_IO", "");
  140.     late_instances[2] = strjoin("boSEQUENTIAL_IO", "");
  141.     late_instances[3] = strjoin("spDIRECT_IO", "");
  142.     late_instances[4] = strjoin("boDIRECT_IO", "");
  143.     late_instances[5] = strjoin("ssUNCHECKED_DEALLOCATION", "");
  144.     late_instances[6] = strjoin("suUNCHECKED_DEALLOCATION", "");
  145.     late_instances[7] = strjoin("ssUNCHECKED_CONVERSION", "");
  146.     late_instances[8] = strjoin("suUNCHECKED_CONVERSION", "");
  147.  
  148.     stubs_to_write = set_new(0);
  149.     units_in_compilation = tup_new(0);
  150.     /* integer arithmetic */
  151.     /* ADA_MIN_INTEGER and ADA_MAX_INTEGER are defined in adasem vars.c */
  152.  
  153.     /* 'standard' symbol table
  154.      * Warning : values are given for SETL only 
  155.      * IN CASE OF CHANGES IN THESE VALUES REPORT CHANGE INTO THE 
  156.      * BINDER (Initialization of idle_task data segment). 
  157.      */
  158. }
  159.  
  160. void initialize_2()                                            /*;initialize_2*/
  161. {
  162.     /*
  163.      * Initializations of file, of variables depending on the option string,
  164.      * and of variables that are to be reset between the two phases
  165.      */
  166.  
  167.     Axq    axq;
  168.     /* Variables */
  169.  
  170. #ifdef TBSL
  171.     STIME       = time;
  172. #endif
  173.     ada_line       = 0;
  174.     NB_INSTRUCTIONS = 0;
  175.     NB_STATEMENTS   = 0;
  176.  
  177.     /* tree map */
  178.  
  179.     if (!new_library) {
  180.         axq = (Axq) emalloct(sizeof(Axq_s), "axq");
  181.         load_library(axq);
  182.     }
  183. }
  184.  
  185. /* print_data_segment moved to segment.c */
  186.  
  187. /* TBSL: Note that INIT_SLOTS should be a procedure, as it is a read-only
  188.  * set
  189.  * It is referenced only by select_entry once initialized, as is the case
  190.  * also with MAX_INDEX.
  191.  */
  192. int init_slots(int kind)                                /*;init_slots*/
  193. {
  194.     int n;
  195.     if (compiling_predef) {
  196.         if (kind == SLOTS_DATA) n =  2;
  197.         else if (kind == SLOTS_CODE) n =  3;
  198.         else if (kind == SLOTS_EXCEPTION)  n = 5;
  199.         else chaos("init_slots bad kind");
  200.     }
  201.     else {
  202.         if (kind == SLOTS_DATA)
  203.         n = 8;
  204.         else if (kind == SLOTS_CODE)
  205.         n = 11;
  206.         else if (kind == SLOTS_EXCEPTION)  n =  15;
  207.         else chaos("init_slots bad kind");
  208.     }
  209.     return n;
  210. }
  211.  
  212. int max_index(int kind)                                            /*;max_index*/
  213. {
  214.     if (kind == SLOTS_DATA) return 255;
  215.     else if (kind == SLOTS_CODE) return 32767;
  216.     else if (kind == SLOTS_EXCEPTION) return 255;
  217.     chaos("max_slots bad kind");
  218.     return 0;
  219. }
  220.  
  221. static Tuple precedes_map_new()                            /*;precedes_map_new*/
  222. {
  223.     return (tup_new(0));
  224. }
  225.  
  226. Slot slot_new(Symbol sym, int number)                            /*;slot_new*/
  227. {
  228.     Slot s;
  229.     char    *sname;
  230.  
  231.     s = (Slot) emalloct(sizeof(Slot_s), "slot-new");
  232.     s->slot_seq = S_SEQ(sym);
  233.     s->slot_unit = S_UNIT(sym);
  234.     sname = ORIG_NAME(sym);
  235.     /* Make copy */
  236.     s->slot_name = (sname == (char *)0) ? (char *)0 : strjoin(sname, "");
  237.  
  238. #ifdef MONITOR
  239. #define NAMESIZE 119
  240.     {
  241.     static FILE *fp = NULL;
  242.     static char source_file[NAMESIZE], *s_file;
  243.     static char *MAIN = "main";
  244.     char *package_name;
  245.     static int length;
  246.  
  247.     /***************************************************/
  248.     /*  Save the file for this procedure.              */
  249.     /***************************************************/
  250.  
  251.     if ( fp == NULL )
  252.     {
  253.         fp = fopen( "CWKLIB.$$$", "r" );
  254.         if ( fp == NULL )
  255.         {
  256.             fprintf(stderr, "Cannot open CWKLIB\n");
  257.         }
  258.         fgets( source_file, NAMESIZE, fp );
  259.         length = strlen(source_file);
  260.         source_file[length-1] = '\0';
  261.         s_file = malloc(length * sizeof(char) );
  262.         strncpy( s_file, source_file, length );
  263.     }
  264.     s->slot_file = s_file;
  265.  
  266.     /***************************************************/
  267.     /*  Save the package name for this procedure.      */
  268.     /***************************************************/
  269.  
  270.     if ( *MON_PACKAGE_NAME == '\0' )
  271.     {
  272.         s->slot_package = MAIN;
  273.     }
  274.     else
  275.     {
  276.         length = strlen( MON_PACKAGE_NAME );
  277.         package_name = malloc( (length+1) * sizeof(char) );
  278.         strcpy( package_name, MON_PACKAGE_NAME );
  279.         s->slot_package = package_name;
  280.     }
  281.     }
  282. #undef NAMESIZE
  283. #endif
  284.  
  285.     s->slot_number = number;
  286.     return s;
  287. }
  288.  
  289. static void init_predef_exceptions()                /*;init_predef_exceptions*/
  290. {
  291.     /* the body of this procedure is obtained by examining the standard
  292.      * output when compiling predef!  Hopefully a more rational scheme
  293.      * of initialization will be provided in the future (after validation).
  294.      *    shields  11-5-85
  295.      */
  296.  
  297.     init_predef_exception(26, 1, 6, "SYSTEM_ERROR");
  298.     init_predef_exception(3, 2, 7, "STATUS_ERROR");
  299.     init_predef_exception(4, 2, 8, "MODE_ERROR");
  300.     init_predef_exception(5, 2, 9, "NAME_ERROR");
  301.     init_predef_exception(6, 2, 10, "USE_ERROR");
  302.     init_predef_exception(7, 2, 11, "DEVICE_ERROR");
  303.     init_predef_exception(8, 2, 12, "END_ERROR");
  304.     init_predef_exception(9, 2, 13, "DATA_ERROR");
  305.     init_predef_exception(10, 2, 14, "LAYOUT_ERROR");
  306.     init_predef_exception(58, 9, 15, "TIME_ERROR");
  307. }
  308.  
  309. static void init_predef_exception(int seq, int unt, int number, char *name)
  310.                                                     /*;init_predef_exception*/
  311. {
  312.     /* seq - sequence of symbol for exception 
  313.      * number - exception number assigned 
  314.      * name - exception name 
  315.      */
  316.  
  317.     Slot s;
  318.     s = (Slot) emalloct(sizeof(Slot_s), "init-predef-exception-slot");
  319.     s->slot_seq = seq;
  320.     s->slot_unit = unt;
  321.     s->slot_name = (name == (char *)0) ? (char *)0 : strjoin(name, "");
  322.     s->slot_number = number;
  323.     EXCEPTION_SLOTS[number] = (char *) s;
  324. }
  325.  
  326. void remove_slots(Tuple tup, int unit)                        /*;remove_slots*/
  327. {
  328.     int        i, n;
  329.     Slot    s;
  330.     /* go through the tuple (CODE_SLOTS or DATA_SLOTS) and remove slots that are
  331.      * attached to the obsolete unit.
  332.      */
  333.     n = tup_size(tup);
  334.     i = 1;
  335.     while (i <= n) {
  336.         s = (Slot) tup[i];
  337.         if (unit == s->slot_unit) {
  338.             tup[i] = tup[n];
  339.             n -= 1;
  340.         }
  341.         else {
  342.             i++;
  343.         }
  344.     }
  345.     tup[0] = (char *)n;
  346. }
  347.  
  348. void remove_interface(Tuple tup, int unit)                /*;remove_interface*/
  349. {
  350.     int        i, n;
  351.     int         unit_nbr;
  352.     /* go through the tuple interfaced_procedures and remove strings that are
  353.      * attached to the obsolete unit.
  354.      */
  355.     n = tup_size(tup);
  356.     i = 1;
  357.     while (i <= n) {
  358.         unit_nbr = (int) tup[i];
  359.         if (unit == unit_nbr) {
  360.             tup[i+1] = tup[n];
  361.             tup[i] = tup[n-1];
  362.             n -= 2;
  363.         }
  364.         else {
  365.             i += 2;
  366.         }
  367.     }
  368.     tup[0] = (char *)n;
  369. }
  370.  
  371. void private_exchange(Symbol package_name)                /*;private_exchange*/ 
  372. {
  373.     Fordeclared     fd1;
  374.     Forprivate_decls    fp1;
  375.     Private_declarations  pd;
  376.     Symbol s1, s2, sym;
  377.     char     *id;
  378.  
  379.     if (NATURE(package_name) == na_package_spec
  380.       || NATURE(package_name) == na_package) {
  381.         pd = (Private_declarations) private_decls(package_name);
  382.         FORPRIVATE_DECLS(s1, s2, pd, fp1);
  383.             private_decls_swap(s1, s2);
  384.         ENDFORPRIVATE_DECLS(fp1);
  385.  
  386.         /* And apply same to inner package specs.*/
  387.  
  388.         FORDECLARED(id, sym, DECLARED(package_name), fd1);
  389.             if (S_UNIT(sym) == S_UNIT(package_name)
  390.               && SCOPE_OF(sym) == package_name) {
  391.                 private_exchange(sym);
  392.             }
  393.         ENDFORDECLARED(fd1);
  394.     }
  395. }
  396.  
  397. void private_install(Symbol package_name)                     /*;private_install*/
  398. {
  399.     Fordeclared    fd1;
  400.     Forprivate_decls fp1;
  401.     Private_declarations  pd;
  402.     Symbol s1, s2;
  403.     int exists;
  404.     char     *id;
  405.  
  406.     /* Install full declarations for unit in context clause. To see if needed,
  407.      * scan priv part to see if currently visible entries contain private types.
  408.      */
  409.     if (NATURE(package_name) == na_package_spec
  410.       || NATURE(package_name) == na_package) {
  411.         pd = (Private_declarations) private_decls(package_name);
  412.         if (pd == (Private_declarations)0) return; /* Not assigned yet.*/
  413.  
  414.         exists = FALSE;
  415.         FORPRIVATE_DECLS(s1, s2, pd, fp1);
  416.             if (TYPE_OF(s1) == symbol_private 
  417.               || TYPE_OF(s1) == symbol_limited_private) {
  418.                 exists = TRUE;
  419.                 break;
  420.             }
  421.         ENDFORPRIVATE_DECLS(fp1);
  422.         if (exists) private_exchange(package_name);
  423.         /* else { */
  424.         /* Check recursively in inner packages. (The outer one may have no
  425.           * private part.
  426.           */
  427.         FORDECLARED(id, s1, DECLARED(package_name), fd1);
  428.             if (s1 != package_name)
  429.                 private_install(s1);
  430.         ENDFORDECLARED(fd1);
  431.         /*} */
  432.     }
  433. }
  434.